home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / oocs / csysinfo.cls < prev    next >
Text File  |  1999-09-06  |  4KB  |  140 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "cSysInfo"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. ' API Functions For obtaing the WInDir and SysDir.
  13. Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  14. Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  15.  
  16. ' API Function to retrive the memory data.   ***API TIP***
  17. ' When called passing in a predefined type with the appropriate members,
  18. ' the members will then be assigned with the needed data.
  19. Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
  20.  
  21. ' Type to store all retrieved _
  22. data about the sys's memory.
  23. Private Type MEMORYSTATUS
  24.    dwLength As Long
  25.    dwMemoryLoad As Long
  26.    dwTotalPhys As Long
  27.    dwAvailPhys As Long
  28.    dwTotalPageFile As Long
  29.    dwAvailPageFile As Long
  30.    dwTotalVirtual As Long
  31.    dwAvailVirtual As Long
  32. End Type
  33.  
  34.  
  35. Const Frmt As String = "###,###,###,###"
  36. Const skb As String = " Kbyte"
  37. Const nkb As Long = 1024
  38.  
  39.  
  40.  
  41.  
  42. '--- this method will handle only the retrieving of the sysinfo.
  43. '--- it will be sent by SendSysInfo
  44.  
  45. Sub GetSysInfo()
  46.     
  47.     Dim i As Integer, ii As Integer
  48.     Dim SysInfo(9) As String
  49.     Dim SysDirs(2) As String, Mem(7) As String
  50.     Dim MemStats As MEMORYSTATUS
  51.          
  52.     
  53.     '  get the Windows Directory
  54.     SysDirs(1) = WinDir
  55.     SysDirs(2) = SysDir
  56.  
  57.     '  get the memory status
  58.     MemStats.dwLength = Len(MemStats)
  59.     ' retrieve the memory data
  60.     GlobalMemoryStatus MemStats
  61.     
  62.     ' format the results int a string array
  63.     Mem(1) = Format$(MemStats.dwMemoryLoad, Frmt) & " % used"
  64.     Mem(2) = Format$(MemStats.dwTotalPhys / nkb, Frmt) & skb
  65.     Mem(3) = Format$(MemStats.dwAvailPhys / nkb, Frmt) & skb
  66.     Mem(4) = Format$(MemStats.dwTotalPageFile / nkb, Frmt) & skb
  67.     Mem(5) = Format$(MemStats.dwAvailPageFile / nkb, Frmt) & skb
  68.     Mem(6) = Format$(MemStats.dwTotalVirtual / nkb, Frmt) & skb
  69.     Mem(7) = Format$(MemStats.dwAvailVirtual / nkb, Frmt) & skb
  70.     
  71.     
  72.     ' Package the retrieved data.
  73.     For i = 1 To 2
  74.        SysInfo(i) = SysDirs(i)
  75.        For ii = 3 To 10
  76.          SysInfo(ii) = Mem(ii - 2)
  77.          If (ii - 2) = 7 Then Exit For
  78.        Next
  79.     Next
  80.     
  81.     Dim info As String
  82.     
  83.     info = SysInfo(1) & ";" & SysInfo(2) & ";" & SysInfo(3) & ";" _
  84.                       & SysInfo(4) & ";" & SysInfo(5) & ";" & SysInfo(6) & ";" _
  85.                       & SysInfo(7) & ";" & SysInfo(8) & ";" & SysInfo(9) & ";"
  86.     
  87.     SendSysInfo info
  88. End Sub
  89.  
  90.  
  91. Private Sub SendSysInfo(strInfo As String)
  92.     '
  93.     ' the data will be sent in packaged form to the Client.
  94.     ' We must use another divider besides "," when sending
  95.     ' data that contains nescasary commas.
  96.     
  97.     ' at the same time you must be ready to accept this from the client
  98.     SendData "SysInfo@" & strInfo
  99. End Sub
  100.  
  101.  
  102.  
  103.  
  104. ' --- Method to retrieve the windows dir
  105.  
  106. Private Function WinDir(Optional ByVal AddSlash As Boolean = False) As String
  107.  
  108.     Dim t As String * 255
  109.     Dim i As Long
  110.     
  111.     i = GetWindowsDirectory(t, Len(t))
  112.     WinDir = Left(t, i)
  113.  
  114.     If (AddSlash = True) And (Right(WinDir, 1) <> "\") Then
  115.        WinDir = WinDir & "\"
  116.     ElseIf (AddSlash = False) And (Right(WinDir, 1) = "\") Then
  117.        WinDir = Left(WinDir, Len(WinDir) - 1)
  118.     End If
  119.  
  120. End Function
  121.  
  122.  
  123. ' --- Method to retrieve the windows\system dir
  124.  
  125. Private Function SysDir(Optional ByVal AddSlash As Boolean = False) As String
  126.  
  127.     Dim t As String * 255
  128.     Dim i As Long
  129.     
  130.     i = GetSystemDirectory(t, Len(t))
  131.        SysDir = Left(t, i)
  132.  
  133.     If (AddSlash = True) And (Right(SysDir, 1) <> "\") Then
  134.        SysDir = SysDir & "\"
  135.     ElseIf (AddSlash = False) And (Right(SysDir, 1) = "\") Then
  136.        SysDir = Left(SysDir, Len(SysDir) - 1)
  137.     End If
  138.  
  139. End Function
  140.